home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / calendar.arc / CALENDAR.BAS
Encoding:
BASIC Source File  |  1985-07-28  |  10.4 KB  |  177 lines
  1.  
  2. 10 CLS
  3. 20 DEFINT D
  4. 30 DIM BD(28),DA(12,7,6),DM(12),M$(12)
  5. 40 GOTO 1270
  6. 50 LPRINT CHR$(27);"E";TAB(32)". ..."
  7. 60 LPRINT TAB(28)".''.' .    '."
  8. 70 LPRINT TAB(23)". '' '.'.:I:.'..   '."
  9. 80 LPRINT TAB(21)".'.:.:....:II:'.'.'.. '."
  10. 90 LPRINT TAB(19)".':.'::.:::.:II:'.'.'.'.. '."
  11. 100 LPRINT TAB(17)".'.'.'.'::.:.:.:I:'.'.'.'. .  '"
  12. 110 LPRINT TAB(16)"..'.'.'.:.:I::.:II:.'..'.'..    ."
  13. 120 LPRINT TAB(15)"..'.'':.:.::.:.::II::.'.'.'.'..   ."
  14. 130 LPRINT TAB(14)"..'.'.'.:.::. .:::II:..'.'.'.'.'.   ."
  15. 140 LPRINT TAB(13)".':.''.':'.'.'.:.:I:'.'.'.'.'..  ..  .."
  16. 150 LPRINT TAB(13)"':. '.':'. ..:.::.::.:.'..:  ':.'.'.. .."
  17. 160 LPRINT TAB(12)".:.:.':'.   '.:':I:.:.. .'.'. ': .'.. . .."
  18. 170 LPRINT TAB(12)"'..:.:'.   .:.II:.:..   . .:. . '.. '. .  .."
  19. 180 LPRINT TAB(11)".. :.:.'.  .:.:I:.:. .  . ..:..:. :..':. .  '."
  20. 190 LPRINT TAB(10)".:. :.:.   .:.:I:.:. .    . ..:I::. :: ::  .. .."
  21. 200 LPRINT TAB(10)".. :'.'.:. .:.:I:'.        ..:.:I:. :: ::.  ..  ."
  22. 210 LPRINT TAB(10)"'..:. .:.. .:II:'         ..:IIIM.  ::. ':.      ."
  23. 220 LPRINT TAB(9)".:.::'.:::..:.AII:.      .::'..  :I .::. '.        ."
  24. 230 LPRINT TAB(9)":..:'.:II:.:I:  ..:'   ' .::PDI'M:: ..:.. ':.    . ."
  25. 240 LPRINT TAB(8)".. :':III:. :.:A'PDF:.  . .P.IP::':: :I:..'::. .   .."
  26. 250 LPRINT TAB(8)". .:.:II: A.'.':.PP:' .  . ..'..' .: :.::. ':...  . .."
  27. 260 LPRINT TAB(8)". .: .:IIIM:.   ' '.' .  ... .   .:. :.:.. :..     .'"
  28. 270 LPRINT TAB(8)". .I.::I:IIA.       ..   ...    ..::.'.'.'.: ..  .  ."
  29. 280 LPRINT TAB(9)".:II.'.':IA:.      ..    ..:.  . .:.: .''.'  ..  . ."
  30. 290 LPRINT TAB(8)"..::I:.'.'::A:.  . .:'-. .-.:..  .:.::AA.. ..:.' .. ."
  31. 300 LPRINT TAB(9)"':II:I:.  ':A:. ..:'   ''.. . : ..:::AMI: ..:..'.'."
  32. 310 LPRINT TAB(8)".':III.::.   'II:.:...::::::::'. .:::AMV:: .::'' .."
  33. 320 LPRINT TAB(8)"..':IIMI::. .  'I:..'::....::'. . .:AII:: :.:'  . ."
  34. 330 LPRINT TAB(8)". . IIMMI:..'.'.'V::. '::::'   ...:AIIV:'.:.'  .. ."
  35. 340 LPRINT TAB(9)". . :IIMI:. .:.:.V:.   ' ' . ...:MI:' .:: :. .  ..'"
  36. 350 LPRINT TAB(9)". .  ':IMII:: ::.IA..      .. .A ...:::' .:.    ."
  37. 360 LPRINT TAB(9)":.  ...'I:I:.: ..AMMA. . .'..AMIV::' . . :      .."
  38. 370 LPRINT TAB(9)":. '.::::II:.I:.MIMMIMMMMMIMMIMV:'..:. .I.':. ..  '."
  39. 380 LPRINT TAB(6)". . .. '':::I:'.::IMMMMMMMMMMMMIMI. '.'.:IMI..  '  '  '."
  40. 390 LPRINT TAB(7)"':... .  ''' .::'.MMMI:MMMMMMMIMI. :IIMMII:. . . .    ."
  41. 400 LPRINT TAB(8)":.:.. . ..::.' .IV'.:I:IIIMIMMIM. .:IM::'.': '..  .  ."
  42. 410 LPRINT TAB(6)". .:.:: .. ::'.'.'..':.::I:I:IMMMIA.'.II.:...:' .' ... . '."
  43. 420 LPRINT TAB(6)"..::::' ...::'.IIMII:: .:.:..:..:III:.'::' .'    .    ..  .."
  44. 430 LPRINT TAB(6)"::.:' .''     .. :IIMI:.:.. ..: . .:I:'' ...:.:.  ..   .. ."
  45. 440 LPRINT TAB(8)".:..::I:.  . . . .IMII:.:'   .. ..'.::.:II:.:. .  ...   . .."
  46. 450 LPRINT TAB(8)". .::.:......'::II:.:'    . ...... . .. .:II:.::  ...  .. .."
  47. 460 LPRINT TAB(7)".:.::.: .    . . .. .:. .... ...:.. . . ..:.::.   :..   . .."
  48. 470 LPRINT TAB(7)".'.::I:.      . .. ..:.... . ....  .. . ..::. .. .I:. ..' ."
  49. 480 LPRINT TAB(6)"'':.: I.       . .. ..:.. .  . .. ..... .:. .:.. .:I.'.''.'"
  50. 490 LPRINT TAB(5)"' .:::I:.       . . .. .:. .    .. ..  . ... .:.'.'I' .  .."
  51. 500 LPRINT TAB(5)". ::.:I:..     . . . ....:. . .   .... ..   .:..:.:.:. ''.'"
  52. 510 LPRINT TAB(7)".::'I:.       .. . ....:. .     .. . ..  ..'..'.:..:..    ."
  53. 520 LPRINT TAB(11)":. .     . .. .. .:.... .  .  .... ...  .  .:.:.:..    '."
  54. 530 LPRINT TAB(11)":.      .  . . .. .:.... . . ........      .:.:.::. .    ."
  55. 540 LPRINT TAB(11)":. .     . . . . .. .::..:  . ..:.. .      :::.:.:.. .    ."
  56. 550 LPRINT TAB(11)":.. .    . . .  . .. ..:.:  .. .. .:. ..    ':::.::.:. .   ."
  57. 560 LPRINT TAB(12)":.. .  . . . .. .. ...::' .. ..  . .:. .    V:I:::::.. .   :."
  58. 570 LPRINT TAB(11)"'::. .  . .. .. ... .:.::  .. .  . .. .. .    V";:GOTO 1070
  59. 580 LPRINT TAB(12)"':.. .   . .. ..:.. ..I:... . .  . .. ... .   V";:GOTO 1080
  60. 590 LPRINT TAB(12)"':.. . . . .. ..:..:.:I:.:. .  . .. . .:. .    V";:GOTO 1090
  61. 600 LPRINT TAB(13)"::..   . . .. ..:..:.MI. .      . . .... .    .";:GOTO 1100
  62. 610 LPRINT TAB(13)"':. .  . .. .. ..:.:.:MI.    . . .. ..... .    M";:GOTO 1110
  63. 620 LPRINT TAB(14)":.. .  . . .. .:.:.:.MI:.      . . .. ... .";:GOTO 1120
  64. 630 LPRINT TAB(15)":..  .  . . .. ..:..IM:.    . . .. .. ...";:GOTO 1130
  65. 640 LPRINT TAB(15)"':..   . . .. ..:.:.:MI..   .  . .. . :::::.  MIM''"
  66. 650 LPRINT TAB(16)":. . .  . .. ..::.:.VI:.     . . .. .:::'::. MIM"
  67. 660 LPRINT TAB(17)":..  .  . .. .:.:.:.V:.    . . . ...::I'A:. MMV"
  68. 670 LPRINT TAB(18)":. .  .  . .. ..:.:.V:.     . . ....::I::'.MV:"
  69. 680 LPRINT TAB(19)":. .  . . . .. .:..II:.  . . . ....':::' AV.'"
  70. 690 LPRINT TAB(20)":.. . . .. ... .:..VI:. . . .. .:. ..:.AV'."
  71. 700 LPRINT TAB(20)"':.. . .  .. ..:.:.:MAI:.:...:.:.:.:.AII:."
  72. 710 LPRINT TAB(21)"I:. .  .. ... .:.:.VMMII:..:.:..:A:'.:.."
  73. 720 LPRINT TAB(22)"IA..  . . .. ..:.:.:VMMMMIMIMMIMI:'.::."
  74. 730 LPRINT TAB(22)"'MA:.  . . .. ..:.:.:MMMIMIMMMIMI:'.::."
  75. 740 LPRINT TAB(23)"MIA: .  . . .. ...:.VMMMIMIIMI::.:..."
  76. 750 LPRINT TAB(23)"MIMI:. .  .. ... .::.MMMIIMIIMI:::.."
  77. 760 LPRINT TAB(23)"MII:.:.  .  .. ... .::VMMIMI:I::.:.."
  78. 770 LPRINT TAB(23)"AI:..:..  .  . .. ..:.VMIII:I::.:. ."
  79. 780 LPRINT TAB(22)"AI:. ..:..  .  . .. ..' VMIII:I:... ."
  80. 790 LPRINT TAB(22)"AI:. .  .:.. .  .  . ...  VMII::..  ."
  81. 800 LPRINT TAB(19)".A:.  .     :.. .  . .. .:.. VMII::..  ."
  82. 810 LPRINT TAB(18)"A:. .  .      ::. .. .. . .:.. 'VMI::.. ."
  83. 820 LPRINT TAB(16)".:.. .   .       :.. .:..... .::.. VMI:.."
  84. 830 LPRINT TAB(15)"... . .   .    . . :.:. ..:. . .::.. VI:..  ."
  85. 840 LPRINT TAB(14)".. .. .   .   . . ...:... . .. . .:::. V:..  ."
  86. 850 LPRINT TAB(13)"'.. ..  .   .  .. ..:::.... .:. . ..::.. V..  ."
  87. 860 LPRINT TAB(10)". .. .. .. . .  . ... ..::IA.. .. . .  ..::. :..  ."
  88. 870 LPRINT TAB(9)".. .. ... . .  .. .... .:.::IA. . .. . ..:.::. :.  ."
  89. 880 LPRINT TAB(8)". . . .. .   . . .. ..:..:.::IIA. . .  .. .:.::. :. ."
  90. 890 LPRINT TAB(7)".. . .  .   . . .. ... ..:.::I:IMA. .  . . ..:.::. . ."
  91. 900 LPRINT TAB(6)".: ..  .  .   . . ... .:.. .:I:IIMMA. .  . .. .::I:. ."
  92. 910 LPRINT TAB(5)".::.  .     . . .. ..:. .::.:IIMIIMMMA.  .  .. ..:I:. . ."
  93. 920 LPRINT TAB(5)"A::..      .  .  ...:..:.::I:IMIMIMMMMA.  .  . ..::I:. ."
  94. 930 LPRINT TAB(4)":MI:.. .       . .. .:.:.::I:IMIMIIMIMMMA. .   ";:GOSUB 1140
  95. 940 LPRINT TAB(4)"AI:.. .. .    . .. .:.:.::II:IMIIIMIMIMMMA.  .";:GOSUB 1150
  96. 950 LPRINT TAB(3)":MI:.. . .   .  . .. .::.:I:IMIMIIIMIMIIMMMA..";:GOSUB 1160
  97. 960 LPRINT TAB(3)"AI:.:.. .  .. .  ... .::.::I:IMIIMIMIMIMIMIMMA";:GOSUB 1170
  98. 970 LPRINT TAB(3)"MI:. .. . .  .  . .. .:..::IIMIMIMIIIIVMIIMMMV";:GOSUB 1180
  99. 980 LPRINT TAB(3)"MI:.. . .  .   . .. ..:.::I:IIMMIIMIMIMIMMMMV'";:GOSUB 1190
  100. 990 LPRINT TAB(3)"MI::.. .  .   .  .. .:..:::IIMIMIIVIVIIVMVV' .";:GOSUB 1200
  101. 1000 LPRINT TAB(3)"MI::... . . .  . ... ..:.:::IIMIVIVIVMVMVV. .";:GOSUB 1210
  102. 1010 LPRINT TAB(3)"II::.:.. . .  .  .. ......:..IMVMIVVMVMV'";:GOSUB 1220
  103. 1020 LPRINT TAB(3)"II:I::.. .  .   .  . .....::.:IMVMVVVMV:.. .";:GOSUB 1230
  104. 1030 LPRINT TAB(3)":II:.:.:.. .  .   . ......:.:.:IVVMVVV:.:..";:GOSUB 1240
  105. 1040 LPRINT TAB(4)"MI::.:. . . .  .  . ...:.::.::.VVMVV::.:.:.. .";:GOSUB 1250
  106. 1050 LPRINT TAB(4)"MII::.:.. .  .  . .. .:..:.'.  'VVVI::.::.:..";:GOSUB 1260
  107. 1060 RETURN
  108. 1070 LPRINT "I:I:::::..   ''B":GOTO 580
  109. 1080 LPRINT "II:I:I:::. .'::":GOTO 590
  110. 1090 LPRINT "MIII:I::.:..':":GOTO 600
  111. 1100 LPRINT "MMIMMMI:I::..:":GOTO 610
  112. 1110 LPRINT "MMMIMII:I::.'":GOTO 620
  113. 1120 LPRINT "   IMMMMIMMIMI:'":GOTO 630
  114. 1130 LPRINT " .   MMMMMMMI:'":GOTO 640
  115. 1140 LPRINT ".. .::I:. ..":RETURN
  116. 1150 LPRINT "  . ..::I:. ..":RETURN
  117. 1160 LPRINT "  . .. .::I:. .":RETURN
  118. 1170 LPRINT ". .  . ..::I:. .":RETURN
  119. 1180 LPRINT "A.  . . .:::I:. . .":RETURN
  120. 1190 LPRINT "  .. . ..:::II: . .":RETURN
  121. 1200 LPRINT ".    .. . ..::III: .  .":RETURN
  122. 1210 LPRINT "  .   . .. .:.:III. .   .":RETURN
  123. 1220 LPRINT ". . . . .  ... .:.:IMI:...":RETURN
  124. 1230 LPRINT "  .  . .  .:..:::IIMII..":RETURN
  125. 1240 LPRINT " .  .  .  . :...:.:IMMI:..":RETURN
  126. 1250 LPRINT "  . .. . :.. ..:IMMI::.'":RETURN
  127. 1260 LPRINT " . .  . .. ':...:II:IIII::":RETURN
  128. 1270 FOR T=1 TO 12:READ DM(T):NEXT:FOR T=1 TO 28:READ BD(T-1):NEXT T:FOR T=1 TO 12:READ M$(T):NEXT T
  129. 1280 LOCATE 5,10 :PRINT STRING$(60,42) : LOCATE 6,10:PRINT "*";STRING$(58,32);"*"
  130. 1290 LOCATE 7,10:PRINT "*";STRING$(22,32);CHR$(34);" S H A R O N ";CHR$(34);STRING$(21,32);"*"
  131. 1300 LOCATE 8,10:PRINT "*";STRING$(58,32);"*":LOCATE 9,10:PRINT STRING$(60,42)
  132. 1310 LOCATE 12,12:PRINT "This program will print a calendar for the year of your"
  133. 1320 LOCATE 13,12:PRINT "choice.  As an option it will also print a VERY NICE"
  134. 1330 LOCATE 14,12:PRINT "picture."
  135. 1340 LOCATE 17,15:PRINT "Make sure printer is on, and paper is aligned !"
  136. 1350 LOCATE 19,15:PRINT "       - PRESS ANY KEY TO CONTINUE -"
  137. 1360 ABC$=INKEY$:IF ABC$="" THEN 1360
  138. 1370 LOCATE 21,10:INPUT "WHAT YEAR ";Y:X=Y-14:IF X<0 THEN 1370 ELSE X=INT(X/28): X=X*28:X=X+14:X=Y-X
  139. 1380 LOCATE 23,10:COLOR 31:PRINT "PLEASE STANDBY":COLOR 7
  140. 1390 C2=1:CO=BD(X)-1
  141. 1400 FOR T=1 TO 12
  142. 1410 C3=C3+1:CO=CO+1:DA(T,CO,C2)=C3:IF CO=7 THEN CO=0:C2=C2+1
  143. 1420 IF C3=DM(T) THEN C3=0:C2=1:NEXT T:GOTO 1440
  144. 1430 GOTO 1410
  145. 1440 LOCATE 23,10:PRINT "PICTURE (Y/N) ?";
  146. 1450 P$=INKEY$:IF P$="" THEN 1450
  147. 1460 IF P$="Y" OR P$="y" THEN GOSUB 50 ELSE 1480
  148. 1470 LPRINT :LPRINT CHR$(14);CHR$(27);"E";TAB(18) CHR$(34); "SHARON"; CHR$(34)
  149. 1480 LPRINT : LPRINT : LPRINT : LPRINT CHR$(14) TAB(18)Y
  150. 1490 LPRINT : LPRINT : LPRINT
  151. 1500 FOR T=1 TO 12 STEP 3:LPRINT CHR$(27);"E";TAB(11)M$(T);TAB(37)M$(T+1);TAB(63)M$(T+2)
  152. 1510 LPRINT : LPRINT
  153. 1520 LPRINT TAB(3)"  S  M  T  W  T  F  S";TAB(29)"  S  M  T  W  T  F  S";TAB(55)"  S  M  T  W  T  F  S";CHR$(27);"F";CHR$(18)
  154. 1530 FOR R=1 TO 6:FOR RR=1 TO 3:LPRINT TAB((RR-1)*26+2);" ";
  155. 1540 FOR TT=1 TO 7:D=DA(T+RR-1,TT,R)
  156. 1550 IF D=0 THEN D$="   ":GOTO 1570
  157. 1560 D$=RIGHT$(" "+STR$(D),3)
  158. 1570 LPRINT D$;
  159. 1580 NEXT TT
  160. 1590 NEXT RR:LPRINT
  161. 1600 NEXT R:LPRINT STRING$(3,138):NEXT T
  162. 1610 LPRINT CHR$(12)
  163. 1620 LOCATE 23,10: PRINT "                ":LOCATE 21,10:PRINT "PRINT ANOTHER  ?";
  164. 1630 Y$=INKEY$:IF Y$="" THEN 1630
  165. 1640 IF Y$="Y" OR Y$="y" THEN 1660
  166. 1650 END
  167. 1660 LOCATE 21,10:PRINT "SAME YEAR (Y/N)?";
  168. 1670 Y$=INKEY$:IF Y$="" THEN 1670
  169. 1680 IF Y$="Y" OR Y$="y" THEN 1440
  170. 1690 RUN
  171. 1700 DATA 31,28,31,30,31,30,31,31,30,31,30,31,3,4,5,7,1,2,3,5,6,7,1,3,4,5,6,1,2,3,4,6,7,1,2,4,5,6,7,2," JANUARY ","FEBRUARY","  MARCH  ","  APRIL  ","   MAY   ","  JUNE   ","  JULY   "," AUGUST  ","SEPTEMBER"," OCTOBER ","NOVEMBER "
  172. 1710 DATA "DECEMBER "
  173.  
  174.  
  175.  
  176.  
  177. RIL  ","   MAY   ","  JUNE   ","  JULY   "," AUGUST  ","SEPTEMBER"," OCTOBER ","NOVEM